perm filename WAVE.SAI[VV,BGB] blob
sn#129812 filedate 1974-12-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00025 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IFC NOMOVE THENC
C00007 00003 REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE
C00013 00004 SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR)
C00014 00005 SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUMREFERENCE STRING SSTRING ARRAY NAME)
C00019 00006 STRING WAIT,LFILE,OFILE,SL
C00022 00007 SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E)
C00024 00008 FORMAT_POINTER←-1
C00029 00009 WAIT←"O.K."
C00036 00010 BEGIN "DOIT"
C00041 00011 BEGIN "BEGIN"
C00046 00012 BEGIN"FREE"
C00048 00013 BEGIN"OPEN_HAND"
C00050 00014 BEGIN"CHANGE"
C00053 00015 IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM)
C00055 00016 BEGIN"RETURN"
C00061 00017 BEGIN "DEFINE"
C00064 00018 BEGIN "DUMP"
C00068 00019 BEGIN"SET"
C00069 00020 BEGIN "EDIT"
C00073 00021 BEGIN "NNUL" SAY_WAITOPEN_ONENO_NULL END"NNUL"
C00076 00022 BEGIN"MOVING"
C00079 00023 IFC GRAPHICS THENC
C00084 00024 SL←SIMIO(ONE_LINE)
C00090 00025 END ELSE
C00092 ENDMK
C⊗;
IFC NOMOVE THENC
DEFINE TSX="1.0017",TSY="1.0028";
DEFINE TYP_HAND="FALSE",DEB_HAND="FALSE";
FORWARD MESSAGE SIMPLE PROCEDURE START_TRAJECTORY(STRING FILE;INTEGER SFL);
INTERNAL INTEGER ARM_MOTION,ARM_STATUS,ARM_SEGMENT,ARM_WAIT,
ARM_TIME,ARM_EXECUTE;
INTERNAL BOOLEAN STOP_ON_TOUCH;
INTERNAL REAL ARRAY TRANS_ARM[1:4,1:4];
INTERNAL INTEGER ARRAY FELT[1:2,1:4,1:4];
REAL ARRAY ARM_LINK[3:6,1:4,1:4];
REAL GRASP;
INTERNAL SAFE REAL ARRAY ARM_VECTOR[1:7];
INTEGER ARM_PLAN;
SAFE REAL ARRAY FREE_ARM[0:6,1:6];
SAFE REAL ARRAY FORCE_ARM[1:6];
INTEGER GDISP_INIT;INTEGER ARRAY GDISP[0:14];
ELSEC
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
ENDC
EXTERNAL SIMPLE PROCEDURE ARMPOS(INTEGER SAVE_CELL);
EXTERNAL SIMPLE PROCEDURE HANDFN;
EXTERNAL SIMPLE PROCEDURE ARMFN(INTEGER NARGS);
EXTERNAL SIMPLE PROCEDURE ARMPROCEED(BOOLEAN REPEAT);
EXTERNAL SIMPLE PROCEDURE DOIT(INTEGER PPPN,BAND,FILE);
EXTERNAL SIMPLE PROCEDURE ARM_JOINT;
REAL ROTAT;
BOOLEAN INTERP;
SAFE REAL ARRAY TRANS[1:4,1:4];
INTERNAL SAFE INTEGER ARRAY ARM_MESSAGE[1:21];
INTEGER IFI,I,J,MESS;
BOOLEAN FRST_OPEN,AEF;
BOOLEAN TEST;
INTEGER N,CHAN;
REAL TX,TY,TZ;
INTEGER HAND;
STRING S,FILE;
INTEGER BREAK,EOF;
INTEGER NNUL,PTR2,PTR3,PTR4;
SAFE REAL ARRAY TH,DIR[1:6];
LABEL EXETRUE,GGET,GET,GET1;
DEFINE TTY="1",ONE_LINE="1",HEAD="2",ID="3",DEL="4";
DEFINE OCTNUM="5",RSB="6",LN="7",SOME="10";
DEFINE NUMS="11",NNUMS="12",DOLLAR="13",SOMETHING="14";
DEFINE FF="15",SEMI="16",ALT_MODE="'175";
DEFINE FREE_DATA_LENGTH="100",MAX_STACK="150";
SAFE INTEGER ARRAY STACK[1:MAX_STACK];
SAFE INTEGER ARRAY COEFF[0:'1037];
REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE;
EXTERNAL SIMPLE INTEGER PROCEDURE HASH(STRING S);
EXTERNAL SIMPLE INTEGER PROCEDURE REHASH;
STRING EDIT_NAME,LINE_NO,SPACES,OL;
SAFE REAL ARRAY XT[1:4,1:4];
SAFE REAL ARRAY XV,YV,ZV[1:4];
DEFINE MAX_MACRO="20";
STRING ARRAY MACRO_FORMAL,MACRO_NAME,MACRO_SOURCE,MACRO_DEFN,FILE_NAME[1:MAX_MACRO];
SAFE INTEGER ARRAY MAC_TOP[0:MAX_MACRO-1];
INTEGER FMN,MAC_EOF,MAC,MAC_FREE;
DEFINE MAX_PAR="30";
SAFE STRING ARRAY MAC_PAR[1:MAX_PAR];
DEFINE MAX_LABELS="100";
STRING ARRAY LABEL_LINE,LABELS[1:MAX_LABELS];
INTEGER ARRAY BBEG,LLAB[0:15];
INTEGER FREEL;
INTEGER ARRAY PTRS[1:MAX_LABELS];
STRING ARRAY CODE_LINE,REF[1:MAX_STACK];
STRING ARRAY FUNNAM[0:'77];
INTEGER ARRAY FUNNUM[0:'77];
STRING ARRAY VECTNAM[0:'77];
STRING ARRAY TRANSNAM[0:'77];
INTEGER ARRAY TRANSNUM[0:'77];
INTEGER ARRAY VECTNUM[0:'77];
PRELOAD_WITH [3] 0, 1.0,[3] 0, 1.0, [3] 0, 1.0;
SAFE REAL ARRAY DATA_BASE[0:FREE_DATA_LENGTH,1:3];
INTEGER FREE_DATA;
REQUIRE "SAY3[SYS,HE]" LOAD_MODULE;
EXTERNAL PROCEDURE SAY(STRING S);
SIMPLE STRING PROCEDURE ERRORS;
BEGIN
IF ARM_STATUS = 1 THEN RETURN("Arithmetic Overflow occured. Something bad has happened.");
IF ARM_STATUS LAND '7 = 1 THEN RETURN("Excessive force occured at joint "&CVS(ARM_STATUS LSH -3));
IF ARM_STATUS = 2 THEN RETURN("Hand closed more than minimum specified in CLOSE function");
IF ARM_STATUS = 3 THEN RETURN("File not found");
IF ARM_STATUS = 4 THEN RETURN("Someone has pawned the DSK");
IF ARM_STATUS = 5 THEN RETURN("Someone has sold the DSK");
IF ARM_STATUS LAND '7 = 6 THEN RETURN("Touch sensors "&CVOS(ARM_STATUS LSH -3)&" have touched something");
IF ARM_STATUS = 7 THEN RETURN("Cannot read the joint positions, usually hardware trouble.");
IF ARM_STATUS = '20 THEN RETURN("Function took too long to execute");
IF ARM_STATUS = '22 THEN RETURN("Hand function took too long to execute.");
IF ARM_STATUS = '23 THEN RETURN("Arm failed to reach force limit set by STOP during motion.");
IF ARM_STATUS = '24 THEN RETURN("Arm in L1: JUMP L1 type loop.");
IF ARM_STATUS = '25 THEN RETURN("Save array number out of bound");
IF ARM_STATUS = '27 THEN RETURN("The function you have called is disconnected.");
IF ARM_STATUS = '30 THEN RETURN("The arm is down");
IF ARM_STATUS = '50 THEN RETURN("Librascope read error");
IF ARM_STATUS = '60 THEN RETURN("You have a very old program which does not match the current servo");
IF ARM_STATUS = '70 THEN RETURN("The reference supply used by the arm is off.");
IF ARM_STATUS = '100 THEN RETURN("The PDP6 is not running.");
IF ARM_STATUS = '200 THEN RETURN("The servo program has been interrupted.");
IF ARM_STATUS = '300 THEN RETURN("The A/D is busy, mabye Colby is running");
IF ARM_STATUS = '400 THEN RETURN("The XGP is in use which upsets the arm");
IF ARM_STATUS = '500 THEN RETURN("Arm solution does not exist");
IF ARM_STATUS = '600 THEN RETURN("SOJG cell does not exist or there are too many");
IF ARM_STATUS = '700 THEN RETURN("Proceed to a servo that is not running");
IF ARM_STATUS = '702 THEN RETURN("Proceed segments do not match");
IF ARM_STATUS = '703 THEN RETURN("Failed to recieve PROCEED from other servo");
IF ARM_STATUS = '1000 THEN BEGIN
SAY("Y↑U\PR1e1Sdxu2R1e2DB/u1\dN H∀∀1 H∀∀1 H∀∀");
RETURN("YOU PUSHED THE RED BUTTON HA HA HA!");
END;
RETURN("Unrecognized error state");
END;
SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR);
BEGIN STRING S;
IF MAC
THEN BEGIN S←SCAN(MACRO_SOURCE[MAC],BR,BREAK);
MAC_EOF←¬(LENGTH(MACRO_SOURCE[MAC]) ∨ LENGTH(S)) END
ELSE S←INPUT(CHAN,BR);
RETURN(S) END"SIMIO";
SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUM;REFERENCE STRING S;STRING ARRAY NAME);
BEGIN LABEL L1;
STRING SN;
INTEGER I;
L1: IF NUM THEN SIMIO(NUMS) ELSE SIMIO(HEAD);
IF MAC_EOF
THEN BEGIN
FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
DO FOR J←BBEG[MAC] STEP 1 UNTIL PTR3+1
DO IF EQU(REF[J],LABELS[I])
THEN BEGIN
IF STACK[J] LAND '77000000 = '26000000 THEN BEGIN
N←PTRS[I]-J+COEFF[(STACK[J] LAND '777777) + 1];
REF[J]←NULL;
IF N+J<1 ∨ N+J>PTR3+1
THEN BEGIN
OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
N←PTR3+1-J END;
COEFF[(STACK[J] LAND '777777) +1]←N END ELSE
BEGIN
START_CODE
MOVE 1,STACK;
ADD 1,J;
HRRE 1,-1(1);
MOVEM 1,N END;
N←PTRS[I]-J+N;
REF[J]←NULL;
IF N+J<1 ∨ N+J>PTR3+1
THEN BEGIN
OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
N←PTR3+1-J END;
STACK[J]←(N LAND '777777) LOR (STACK[J] LAND '777000000) END;END;
FOR J←BBEG[MAC] STEP 1 UNTIL PTR3
DO IF LENGTH(REF[J])
THEN BEGIN OUTSTR(CODE_LINE[J]&REF[J]&" UNDEFINED"&'15&'12);
STACK[J]←(PTR3+1-J) LOR '102000000;
REF[J]←NULL;
LABEL_LINE[J]←NULL END;
MAC_FREE←MAC_TOP[MAC];
FREEL←LLAB[MAC]-1;
MAC←MAC-1;
MAC_EOF←0;
IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*"&'15&'12)END;
GO TO L1 END;
IF EOF THEN BEGIN RELEASE(CHAN);
CHAN←CHAN-1;
IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*"&'15&'12)END;
GO TO L1; END;
IF BREAK=-1
THEN BEGIN LINE_NO←SIMIO(LN);
GO TO L1 END;
IF BREAK=";" THEN BEGIN SIMIO(ONE_LINE); GO TO L1 END;
IF BREAK="$"
THEN BEGIN I←INTSCAN(S←SIMIO(NNUMS),J);
I←I+MAC_TOP[MAC];
IF I<1 ∨ I> MAC_FREE
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
GO TO L1 END;
S←MAC_PAR[I] END
ELSE S←IF NUM THEN SIMIO(NNUMS) ELSE SIMIO(ID);
IF NUM THEN BEGIN
SN←SCAN(S,DOLLAR,J);
IF J="$" THEN BEGIN
I←INTSCAN(S,J);
I←I+MAC_TOP[MAC];
IF I<1 ∨ I> MAC_FREE
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
GO TO L1 END;
S←SN&MAC_PAR[I] END ELSE S←SN;
RETURN(-1) END;
IF BREAK=":"
THEN BEGIN
FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
DO IF EQU(S,LABELS[I])
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" MULTIPLY DEFINED LABEL"&'15&'12);
GO TO L1 END;
LABELS[FREEL←FREEL+1]←S;
LABEL_LINE[FREEL]←FILE_NAME[CHAN]&LINE_NO;
PTRS[FREEL]←PTR3+1;
GO TO L1 END;
I←HASH(S);
WHILE LENGTH(NAME[I])
DO BEGIN IF EQU(S,NAME[I]) THEN DONE;
I←REHASH END;
RETURN(I) END;
STRING WAIT,LFILE,OFILE,SL;
SIMPLE PROCEDURE OPEN_ONE;
IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((LFILE←FILE←OFILE),0);
FORWARD SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E);
SIMPLE INTEGER PROCEDURE INTERN(STRING S;STRING ARRAY NAME);
BEGIN INTEGER I;
I←HASH(S);
WHILE LENGTH(NAME[I])
DO BEGIN IF EQU(S,NAME[I]) THEN RETURN(I);
I←REHASH END;
NAME[I]←S;
RETURN(I) END;
DEFINE SAY_WAIT="IF ¬MAC ∧ CHAN=1 THEN OUTSTR(WAIT&'15&'12)";
BOOLEAN SIMPLE PROCEDURE READT(REAL ARRAY T;REFERENCE STRING S;STRING MESS);
BEGIN INTEGER I;
SAFE OWN REAL ARRAY E[1:6];
I←GETNAME(FALSE,S,TRANSNAM);
IF LENGTH(TRANSNAM[I])
THEN BEGIN ARRBLT(E[1],DATA_BASE[TRANSNUM[I],1],6);
CONSTRUCT(T,E);
RETURN(TRUE) END;
OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
RETURN(FALSE) END;
BOOLEAN SIMPLE PROCEDURE READV(REAL ARRAY V;REFERENCE STRING S;STRING MESS);
BEGIN INTEGER I;
I←GETNAME(FALSE,S,VECTNAM);
IF LENGTH(VECTNAM[I])
THEN BEGIN ARRBLT(V[1],DATA_BASE[VECTNUM[I],1],3);
V[4]←1;
RETURN(TRUE) END;
OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
RETURN(FALSE) END;
SAFE REAL ARRAY TT1[1:4,1:4];
IFC BLUE THENC
PRELOAD_WITH 20,30,1,0,90,0; SAFE REAL ARRAY ANEW[1:6];
ELSEC
PRELOAD_WITH 20,30,1,180,90,0; SAFE REAL ARRAY ANEW[1:6];
ENDC
IFC GRAPHICS THENC
REQUIRE"DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
ENDC
STRING FUNCTION,S11,SM,DFILE;
PRELOAD_WITH 100.0, 100.0, 100.0, 100.0, 100.0, 100.0;
SAFE REAL ARRAY THFAC[1:6];
REQUIRE "VECTOR[SYS,HE]" SOURCE_FILE;
SIMPLE PROCEDURE CONSTRUCT(SAFE REAL ARRAY T,E);
BEGIN
REAL SI1,SI2,SI3,CO1,CO2,CO3;
T[1,4]←E[1]*TSX;
T[2,4]←E[2]*TSY;
T[3,4]←E[3];
SI1←SIND(E[4]);CO1←COSD(E[4]);
SI2←SIND(E[5]);CO2←COSD(E[5]);
SI3←SIND(E[6]);CO3←COSD(E[6]);
T[1,1]←-SI1*SI2*CO3+CO1*SI3;
T[1,2]← SI1*SI2*SI3+CO1*CO3;
T[2,1]← CO1*SI2*CO3+SI1*SI3;
T[2,2]←-CO1*SI2*SI3+SI1*CO3;
T[1,3]← SI1*CO2;
T[2,3]←-CO1*CO2;
T[3,1]←-CO2*CO3;
T[3,2]← CO2*SI3;
T[3,3]←-SI2;
T[4,1]←T[4,2]←T[4,3]←0;
T[4,4]←1;
END;
SIMPLE PROCEDURE UNSTRUCT(SAFE REAL ARRAY T,E);
BEGIN
REAL CO2;
E[1]←T[1,4]/TSX;
E[2]←T[2,4]/TSY;
E[3]←T[3,4];
E[5]←RAD*ATAN2(-T[3,3],CO2←SQRT(T[1,3]↑2+T[2,3]↑2));
IF CO2<0.01 THEN BEGIN
E[4]←RAD*ATAN2(T[2,2],T[1,2]);
E[6]←0;
RETURN END;
E[4]←RAD*ATAN2(T[1,3],-T[2,3]);
E[6]←RAD*ATAN2(T[3,2],-T[3,1])
END;
REAL R;
SAFE REAL ARRAY VT,VT1,VT2[1:4];
PRELOAD_WITH [2] 0.0, [2] 1.0;
SAFE REAL ARRAY UZ[1:4];
SAFE REAL ARRAY ST[1:6];
INTEGER NMASK,TIP,PAD,HIT,LL,UL,MODULUS,PTR,TIME,INDEX,BP;
REAL FACTOR;
PRELOAD_WITH 0;
SAFE INTEGER ARRAY BUFFER[0:100];
REQUIRE "TRAJ.SAI[SYS,HE]" SOURCE_FILE;
FORMAT_POINTER←-1;
INTERP←TRUE;
RESET_CONO;
AEF←ARM_EXECUTE←FALSE;
PUSH_FORMAT(10,4);
ARM_SEGMENT←0;
ARM_MOTION←0;
FAST←TRUE;
FOR I←0 STEP 1 UNTIL '37 DO BANDS[I]←NULL;
NEXT_BAND←0;
STOP_ON_TOUCH←FALSE;
FOR I←1 STEP 1 UNTIL 6 DO MMOVE(A[SQAR(I)],A[SQAR(I)]);
MMOVE(Q[0],Q[0]);
MMOVE(Q[17],Q[17]);
FOR I←1 STEP 1 UNTIL 3 DO DEPART_ARM[I]←ARRIVE_ARM[I]←IF I=3 THEN 3.0 ELSE 0.0;
DEPART_ARM[4]←ARRIVE_ARM[4]←1.0;
FOR I←1 STEP 1 UNTIL 6 DO BEGIN
N←SQAR(I);
MMOVE(JMAT[N],JMAT[N])END ;
HANDPOS(V0);
ARRBLT(PARK_TRANS[1,1],T[SQAR(6)],16);
DO BEGIN
ARM_POSITION(NULL);
IF ARM_STATUS THEN
IFC WAVE THENC
BEGIN OUTSTR(ERRORS&"
TYPE Y TO START FROM PARK ELSE CHECK PDP-6 AND TYPE C/R"&CRLF);
ELSEC
BEGIN OUTSTR(CVOS(ARM_STATUS)&"
TYPE Y TO START FROM PARK ELSE CHECK PDP-6 AND TYPE C/R"&CRLF);
ENDC
S←INCHWL;
IF S="Y" THEN BEGIN
ARRTRAN(ARM_VECTOR,V0);
ARM_VECTOR[7]←0;
UPDATE_SEG;
ARM_STATUS←0 END;
END;
END UNTIL ¬ARM_STATUS;
ARRTRAN(LAST_ARM,ARM_VECTOR);
WAIT←"O.K.";
SPACES←" ";
GDISP_INIT←0;
OPEN(TTY,"TTY",0,2,0,120,BREAK,EOF);
OL←EDIT_NAME←LFILE←FILE←NULL;
WAS_FORCED←TRUE;
FREEL←0;
FOR I←0 STEP 1 UNTIL 15 DO LLAB[I]←1;
IFC BLUE THENC
OFILE←"BLUE";
ELSEC
OFILE←"YELLOW";
ENDC
SETBREAK(ONE_LINE,'12&ALT_MODE,'14&'15,"IN");
SETBREAK(SOME,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRDK");
SETBREAK(SOMETHING,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ"&'12,'15,"ILRDK");
SETBREAK(HEAD,"$;ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRDK");
SETBREAK(ID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",NULL,"XNK");
SETBREAK(RSB,"]",NULL,"IAN");
SETBREAK(DEL,"()[] ,;: ",NULL,"IN");
SETBREAK(NUMS,"0123456789.@+-$;",NULL,"ILR");
SETBREAK(NNUMS,"$0123456789.@+-",NULL,"XL");
SETBREAK(DOLLAR,"$",NULL,"I");
SETBREAK(LN," ",NULL,"IA");
SETBREAK(FF,'14,NULL,"I");
SETBREAK(SEMI,";",NULL,"IR");
NMASK←'777777774000;
CHAN←TTY;
FMN←MAC←MAC_EOF←EOF←MAC_FREE←0;
FUNNUM[INTERN("DO",FUNNAM)]←0;
FUNNUM[INTERN("REQUIRE",FUNNAM)]←1;
FUNNUM[INTERN("TRANS",FUNNAM)]←2;
FUNNUM[INTERN("VECT",FUNNAM)]←3;
FUNNUM[INTERN("BEGIN",FUNNAM)]←4;
FUNNUM[INTERN("PARK",FUNNAM)]←5;
FUNNUM[INTERN("MOVE",FUNNAM)]←6;
FUNNUM[INTERN("STEP",FUNNAM)]←7;
FUNNUM[INTERN("DRAW",FUNNAM)]←8;
FUNNUM[INTERN("FREE",FUNNAM)]←9;
FUNNUM[INTERN("SPIN",FUNNAM)]←10;
FUNNUM[INTERN("FORCE",FUNNAM)]←11;
FUNNUM[INTERN("STOP",FUNNAM)]←12;
FUNNUM[INTERN("OPEN",FUNNAM)]←13;
FUNNUM[INTERN("SKIPE",FUNNAM)]←14;
FUNNUM[INTERN("JUMP",FUNNAM)]←15;
FUNNUM[INTERN("CLOSE",FUNNAM)]←16;
FUNNUM[INTERN("CENTER",FUNNAM)]←17;
FUNNUM[INTERN("PLACE",FUNNAM)]←18;
FUNNUM[INTERN("CHANGE",FUNNAM)]←19;
FUNNUM[INTERN("DRIVE",FUNNAM)]←20;
FUNNUM[INTERN("WAIT",FUNNAM)]←21;
FUNNUM[INTERN("MERGE",FUNNAM)]←22;
FUNNUM[INTERN("SAVE",FUNNAM)]←23;
FUNNUM[INTERN("RESTORE",FUNNAM)]←24;
FUNNUM[INTERN("TOUCH",FUNNAM)]←25;
FUNNUM[INTERN("CONO",FUNNAM)]←26;
FUNNUM[INTERN("END",FUNNAM)]←27;
FUNNUM[INTERN("FLUSH",FUNNAM)]←28;
FUNNUM[INTERN("P",FUNNAM)]←29;
FUNNUM[INTERN("ASSERT",FUNNAM)]←30;
FUNNUM[INTERN("PROCEED",FUNNAM)]←31;
FUNNUM[INTERN("PAUSE",FUNNAM)]←32;
FUNNUM[INTERN("DEPART",FUNNAM)]←33;
FUNNUM[INTERN("RETURN",FUNNAM)]←34;
FUNNUM[INTERN("GRASP",FUNNAM)]←35;
FUNNUM[INTERN("LISTEN",FUNNAM)]←36;
FUNNUM[INTERN("WOBBLE",FUNNAM)]←37;
FUNNUM[INTERN("WHERE",FUNNAM)]←38;
FUNNUM[INTERN("HERE",FUNNAM)]←38;
FUNNUM[INTERN("SKIPN",FUNNAM)]←39;
FUNNUM[INTERN("SKIPS",FUNNAM)]←40;
FUNNUM[INTERN("DEFINE",FUNNAM)]←41;
FUNNUM[INTERN("DUMP",FUNNAM)]←42;
FUNNUM[INTERN("SET",FUNNAM)]←43;
FUNNUM[INTERN("ED",FUNNAM)]←44;
FUNNUM[INTERN("NNUL",FUNNAM)]←45;
FUNNUM[INTERN("SEARCH",FUNNAM)]←46;
FUNNUM[INTERN("AOJ",FUNNAM)]←47;
FUNNUM[INTERN("GO",FUNNAM)]←48;
FUNNUM[INTERN("GOTO",FUNNAM)]←6;
FUNNUM[INTERN("SCREW",FUNNAM)]←49;
FUNNUM[INTERN("MOVING",FUNNAM)]←50;
FUNNUM[INTERN("ASSIGN",FUNNAM)]←51;
FUNNUM[INTERN("SOJG",FUNNAM)]←52;
IFC THROWING THENC
FUNNUM[INTERN("THROW",FUNNAM)]←53;
FUNNUM[INTERN("TOSS",FUNNAM)]←54;
IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←55;ENDC
ELSEC IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←53;ENDC ENDC
VECTNUM[INTERN("X",VECTNAM)]←1;
VECTNUM[INTERN("Y",VECTNAM)]←2;
VECTNUM[INTERN("Z",VECTNAM)]←3;
VECTNUM[INTERN("NIL",VECTNAM)]←0;
FREE_DATA←4;
OUTSTR("DO YOU WANT THE FILES SAVED?
");
IF INCHWL THEN FAST←FALSE;
IFC BLUE THENC
OUTSTR("I AM CURIOUS BLUE
");
ELSEC
OUTSTR("I AM CURIOUS YELLOW
");
ENDC
IFC THROWING THENC
IFC BLUE THENC OUTSTR("AND I CAN THROW, TOO"&CRLF);
ELSEC OUTSTR("AND CAN THROW VERY MELLOW"&CRLF); ENDC
ENDC
IFC ¬WAVE THENC
IFC BLUE THENC
PUT_DATA(0,0,"HANDB");
ELSEC
PUT_DATA(0,0,"HANDY");
ENDC
YES_HAND←-1;
ENDC
GO TO GET1;
GET:SIMIO(ONE_LINE);
GET1:SETFORMAT(10,2);
GGET:
IF AEF ∧ ARM_STATUS THEN BEGIN
OUTSTR("ERROR "& CVOS(ARM_STATUS)&CRLF&ERRORS&CRLF);
MAC_FREE←MAC←MAC_EOF←0;
FOR CHAN←CHAN STEP -1 UNTIL 2 DO RELEASE(CHAN);
END;
IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*"&CRLF);
AEF←FALSE;
I←GETNAME(FALSE,S,FUNNAM);
IF CHAN>1 ∧ EQU(S,"COMMENT") THEN BEGIN
DO INPUT(CHAN,FF) UNTIL BREAK='14;
GO TO GGET END;
IF LENGTH(FUNNAM[I]) THEN EXETRUE:CASE FUNNUM[I] OF BEGIN
BEGIN "DOIT"
INTEGER J;
STRING PS,PN;
J←0;
ARM_EXECUTE←AEF←TRUE;
IF BREAK≠'15
THEN BEGIN I←GETNAME(FALSE,S,FUNNAM);
IF LENGTH(FUNNAM[I]) THEN GO TO EXETRUE;
LFILE←S;
IF BREAK="["
THEN BEGIN SL←SIMIO(RSB);
PS←SCAN(SL,DEL,BREAK);
PS←SPACES[1 FOR (3-LENGTH(PS))]&PS;
PN←SCAN(SL,DEL,BREAK);
PN←SPACES[1 FOR (3-LENGTH(PN))]&PN;
J←CVSIX(PS&PN) END END
ELSE S←LFILE;
SAY_WAIT;
IF LENGTH(FILE) THEN BEGIN
CLOSE_TRAJECTORY;
FILE←NULL;
END;
DO_IT(J,S);
GO TO GET1;
END"DOIT";
BEGIN "REQUIRE"
SIMIO(HEAD);
FILE_NAME[CHAN+1]←(S←SIMIO(ID))&'11;
IFC BLUE THENC
IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".BLU";
ELSEC
IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".YEL";
ENDC
IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
OPEN(CHAN+1,"DSK",0,2,0,120,BREAK,EOF);
LOOKUP(CHAN+1,S,EOF);
IF EOF≠0 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&" "&LINE_NO&"FILE NOT FOUND"&CRLF);
RELEASE(CHAN+1);GO TO GET END;
CHAN←CHAN+1;
GO TO GET1;
END "REQUIRE";
BEGIN "TRANS"
INTEGER PTR;
SAFE OWN REAL ARRAY E[1:6];
SAFE OWN REAL ARRAY VT,VTT[1:4];
PTR←GETNAME(FALSE,S,TRANSNAM);
IF ¬LENGTH(TRANSNAM[PTR])
THEN BEGIN
IF FREE_DATA+2>FREE_DATA_LENGTH
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
TRANSNAM[PTR]←S;
TRANSNUM[PTR]←FREE_DATA;
ARRBLT(E[1],ANEW[1],6);
FREE_DATA←FREE_DATA+2 END
ELSE ARRBLT(E[1],DATA_BASE[TRANSNUM[PTR],1],6);
IF ¬MAC ∧ CHAN=1 THEN BEGIN SIMIO(ONE_LINE);
OUTSTR(" X Y Z O A T"&CRLF);
WHILE TRUE DO BEGIN
FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
OUTSTR(CRLF&"CHANGE?"&CRLF);
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
FOR I←1 STEP 1 UNTIL 6 DO
IF LENGTH(S) THEN BEGIN
SL←SCAN(S,DEL,IFI);
R←REALSCAN(SL,IFI);
IF IFI≠-1 THEN E[I]←R;
END;
END;
END ELSE FOR I←1 STEP 1 UNTIL 6 DO BEGIN
GETNAME(TRUE,S,VECTNAM);
E[I]←REALSCAN(S,BREAK) END;
ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6);
GO TO GET1;
END"TRANS";
BEGIN "VECT"
INTEGER PTR;
PTR←GETNAME(FALSE,S,VECTNAM);
IF ¬LENGTH(VECTNAM[PTR])
THEN BEGIN
IF FREE_DATA+1>FREE_DATA_LENGTH
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
VECTNAM[PTR]←S;
VECTNUM[PTR]←FREE_DATA;
FOR I←1 STEP 1 UNTIL 3 DO XV[I]←0;
FREE_DATA←FREE_DATA+1 END
ELSE ARRBLT(XV[1],DATA_BASE[VECTNUM[PTR],1],3);
XV[4]←1;
IF ¬MAC ∧ CHAN=1 THEN
BEGIN
SIMIO(ONE_LINE);
WHILE TRUE DO
BEGIN PVECT(NULL,XV);
OUTSTR("CHANGE ?"&CRLF);
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
FOR I←1 STEP 1 UNTIL 3 DO
IF LENGTH(S) THEN
BEGIN
SL←SCAN(S,DEL,IFI);
R←REALSCAN(SL,IFI);
IF IFI≠-1 THEN XV[I]←R;
END;
END;
END ELSE FOR I←1 STEP 1 UNTIL 3 DO
BEGIN
GETNAME(TRUE,S,VECTNAM);
XV[I]←REALSCAN(S,BREAK)
END;
ARRBLT(DATA_BASE[VECTNUM[PTR],1],XV[1],3);
GO TO GET1;
END "VECT";
BEGIN "BEGIN"
IF FILE THEN CLOSE_TRAJECTORY ;
GETNAME(FALSE,LFILE,VECTNAM);
FILE←LFILE;
SAY_WAIT;
START_TRAJECTORY(FILE,0);
END"BEGIN";
BEGIN "PARK"
SAY_WAIT;
OPEN_ONE;
PARK_ARM;
END"PARK";
BEGIN "MOVE"
REAL DIST,DEG;
BOOLEAN GOM;
GOM←EQU(S,"GOTO");
IF READT(TT1,S,"MOVE - "&S&" TRANSFORM DOSN'T EXIST")
THEN BEGIN SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
SCALE(XV,XV,DIST);
REDUCE(XV);
XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
FOR I←1 STEP 1 UNTIL 3 DO BEGIN
CVV(XV,TT1,I);
REVOLVE(XV,YV,DEG);
CVC(TT1,I,XV) END;
END;
END;
SAY_WAIT;
OPEN_ONE;
IF GOM THEN GO_ARM(TT1,ARM_PLAN) ELSE MOVE_ARM(TT1,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
END"MOVE";
BEGIN"STEP"
IFC WAVE THENC
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
IF 1≤ I ≤6 THEN STEP_ARM(I,R,J) ELSE OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
ELSEC
OUTSTR("NO STEP IN THIS VERSION"&CRLF);
ENDC
END"STEP";
BEGIN "DRAW"
INTEGER I;
SAFE OWN REAL ARRAY PROFILE[0:5,1:4];
SAFE OWN REAL ARRAY DP[1:4];
EXTERNAL SIMPLE PROCEDURE MOVEV(REFERENCE REAL R;REAL ARRAY S);
IF ¬MAC ∧ CHAN=1 THEN BEGIN OUTSTR("POSITION,ROTATION,ANGLE
CRANK,AXIS,DEGREES
TIME,LOOP"&CRLF);
SIMIO(ONE_LINE) END;
IF ¬READV(XV,S,"NEW POSITION MISSING") THEN GO TO GET;
MOVEV(DP[1],XV);
REDUCE(DP);
DP[1]←DP[1]*TSX;
DP[2]←DP[2]*TSY;
MOVEV(PROFILE[1,1],DP);
IF ¬READV(YV,S,"ROTATION AXIS MISSING") THEN GO TO GET;
MOVEV(PROFILE[2,1],YV);
GETNAME(TRUE,S,FUNNAM);
PROFILE[3,1]←REALSCAN(S,BREAK);
IF ¬(READV(XV,S,"CRANK MISSING") ∧ READV(YV,S,"AXIS MISSING"))THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
PROFILE[3,2]←REALSCAN(S,BREAK);
MOVEV(PROFILE[4,1],XV);
MOVEV(PROFILE[5,1],YV);
GETNAME(TRUE,S,FUNNAM);
PROFILE[0,2]←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
PROFILE[0,3]←INTSCAN(S,BREAK);
IF PROFILE[0,3] ∧ ¬(ABS(PROFILE[3,2])=360 ∨ ABS(PROFILE[3,1])=360)
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNLOOPABLE
"); GO TO GET END;
SAY_WAIT;
OPEN_ONE;
DRAW_ARM(PROFILE,ARM_PLAN);
IF ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"DRAW - SORRY"&CVOS(ARM_PLAN)&CRLF);
END"DRAW";
BEGIN"FREE"
GETNAME(TRUE,S,FUNNAM);
OPEN_ONE;
J←INTSCAN(S,BREAK);
FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
BEGIN
FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
IF READV(XV,S,"MISSING FREE")
THEN BEGIN REDUCE(XV);
ARRBLT(FREE_ARM[I,1],XV[1],3)END;
END;
FREE_ARM[0,1]←FREE_ARM[0,1]+J;
END"FREE";
BEGIN"SPIN"
GETNAME(TRUE,S,FUNNAM);
OPEN_ONE;
J←INTSCAN(S,BREAK);
FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
BEGIN
FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
IF READV(XV,S,"MISSING FREE")
THEN BEGIN REDUCE(XV);
ARRBLT(FREE_ARM[I,4],XV[1],3)END;
END;
FREE_ARM[0,1]←FREE_ARM[0,1]+J;
END"SPIN";
BEGIN"FORCE"
IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
THEN BEGIN REDUCE(XV);
OPEN_ONE;
ARRBLT(FORCE_ARM[1],XV[1],3);
REDUCE(YV);
ARRBLT(FORCE_ARM[4],YV[1],3) END;
END"FORCE";
BEGIN "STOP"
IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
THEN BEGIN SAY_WAIT;
OPEN_ONE;
STOP_ARM(XV,YV) END;
END"STOP";
BEGIN"OPEN_HAND"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
OPEN_HAND(R);
END"OPEN_HAND";
BEGIN"SKIPE"
STRING SL;
SL←SIMIO(ONE_LINE);
I←CVO(SL);
SAY_WAIT;
ARM_SKIPE(I);
GO TO GET1
END"SKIPE";
BEGIN"JUMP"
STRING SC;
CODE_LINE[PTR3+1]←LINE_NO;
S←SC←SIMIO(ONE_LINE);
SCAN(SC,HEAD,J);
IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
THEN BEGIN SC←BREAK&SC;
I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
SAY_WAIT;
OPEN_ONE;
ARM_JMP(I);
GO TO GET1;
END"JUMP";
BEGIN "CLOSE_HAND"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
CLOSE_HAND(R);
END"CLOSE_HAND";
BEGIN "CENTER"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
CENTER_HAND(R);
END"CENTER";
BEGIN "PLACE"
SAY_WAIT;
OPEN_ONE;
PLACE_ARM;
END"PLACE";
BEGIN"CHANGE"
REAL DIST,DEG;
INTEGER TIME;
OPEN_ONE;
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
TIME←INTSCAN(S,BREAK);
SAY_WAIT;
CHANGE_ARM(XV,DIST,YV,DEG,TIME,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"CAREFUL"&CRLF);
END"CHANGE";
BEGIN"DRIVE"
INTEGER I,J;
REAL R;
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
DRIVE_ARM(I,R,J,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
END"DRIVE";
BEGIN"WAIT"
S←SIMIO(ONE_LINE);
IF LENGTH(S) THEN S←S&'15&'12;
SAY_WAIT;
WAIT_ARM(S);
GO TO GET1;
END"WAIT";
BEGIN"MERGE"
SAY_WAIT;
MERGE_ARM;
END"MERGE";
BEGIN"SAVE"
LABEL L1;
GETNAME(FALSE,S,VECTNAM);
L1: SAY_WAIT;
OPEN_ONE;
ARM_SAVE(S);
END"SAVE";
BEGIN"RESTORE"
LABEL L1;
INTEGER I;
STRING SL;
GETNAME(FALSE,S,VECTNAM);
L1: GETNAME(TRUE,SL,FUNNAM);
I←INTSCAN(SL,BREAK);
SAY_WAIT;
OPEN_ONE;
ARM_RESTORE(S,I);
END"RESTORE";
BEGIN "TOUCH"
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
SET_TOUCH(I);
END"TOUCH";
BEGIN"CONO"
IF (READV(XV,S,"APPROACH DOES NOT EXIST")
∧ READV(ZV,S,"OBJECT DOES NOT EXIST"))
THEN BEGIN
OPEN_ONE;
GETNAME(TRUE,S,FUNNAM);
ZV[4]←REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
I←INTSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
J←INTSCAN(S,BREAK);
SAY_WAIT;
ARM_CONO(XV,ZV,I,J);
END;
END "CONO";
BEGIN"END"
SAY_WAIT;
IF LENGTH(FILE) THEN CLOSE_TRAJECTORY;
FILE←NULL;
END"END";
IF LENGTH(FILE) THEN FLUSH(0,LAST_ARM);
BEGIN "P"
S←SIMIO(ONE_LINE);
I←INTSCAN(S,BREAK);
SAY_WAIT;
DO_PROCEED(I);
AEF←TRUE;
GO TO GET1;
END"P";
BEGIN"ASSERT"
IF ¬READT(XT,S,"ASSERT- "&S&" TRANSFORM DOSN'T EXIST") THEN GO TO GET;
ARRTRAN(LAST_TRANS,XT);
ARRTRAN(LAST_PLANNED_TRANS,XT);
ARM_SOLVE(XT,LAST_ARM);
ARRTRAN(LAST_PLANNED_ARM,LAST_ARM);
END"ASSERT";
BEGIN"PROCEED"
SAY_WAIT;
OPEN_ONE;
OTHER_GO;
END"PROCEED";
BEGIN"PAUSE"
SAY_WAIT;
OPEN_ONE;
OTHER_WAIT;
END"PAUSE";
BEGIN "DEPART"
IF ¬READV(YV,S,"DEPART DOSN'T EXIST")THEN GO TO GET;
OPEN_ONE;
ARRTRAN(DEPART_ARM,YV);
END "DEPART";
BEGIN"RETURN"
SAY_WAIT;
OPEN_ONE;
OTHER_RUN;
END"RETURN";
OUTSTR(CVF(GRASP)&CRLF);
BEGIN"LISTEN"
INTERP←FALSE;
SAY_WAIT;
IFC WAVE THENC OUTSTR("RUN HAND FOR LISTEN"&CRLF);
ELSEC
IFC BLUE THENC
WHILE ¬INTERP DO QUEUE('600, GET_ENTRY('120,NULL,"HANDB",NULL));
ELSEC
WHILE ¬INTERP DO QUEUE('600, GET_ENTRY('120,NULL,"HANDY",NULL));
ENDC
ENDC
END;"LISTEN"
BEGIN"WOBBLE"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
WOBBLE_HAND(R);
END"WOBBLE";
BEGIN "POS"
SAFE OWN REAL ARRAY T[1:4,1:4];
STRING NN;
INTEGER I,PTR,IFI,J;
SAFE OWN REAL ARRAY TV[1:4];
SAFE OWN REAL ARRAY E[1:6];
LABEL JP;
REAL DEG,DIST,R;
BOOLEAN HC,GOM;
IF GOM←EQU(S,"HERE") THEN BEGIN
SAY_WAIT;
ARM_POSITION(NULL);
AEF←TRUE;
ARRBLT(T[1,1],ARM_LINK[6,1,1],16);
PTR←GETNAME(FALSE,NN,TRANSNAM);
SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
HC←0;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
SCALE(XV,XV,DIST);
REDUCE(XV);
XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
IF HC THEN REVOLVE(XV,YV,-DEG);
FOR I←1 STEP 1 UNTIL 3 DO BEGIN
CVV(TV,T,I);
REVOLVE(TV,YV,-DEG);
CVC(T,I,TV) END;
END;
FOR J←1 STEP 1 UNTIL 3 DO T[J,4]←T[J,4]-XV[J];
END;
END;
IF ¬GOM
THEN BEGIN
SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";"
THEN GETNAME(FALSE,S,FUNNAM)ELSE S←NULL;
SAY_WAIT;
ARM_POSITION(S);
AEF←TRUE;
IF LENGTH(S)
THEN BEGIN
TRANS_ARM[1,4]←TRANS_ARM[1,4]/TSX;
TRANS_ARM[2,4]←TRANS_ARM[2,4]/TSY;
PMAT(S,TRANS_ARM);
GO TO GET1;
END
ELSE ARRBLT(T[1,1],ARM_LINK[6,1,1],16)
END
ELSE BEGIN
IF ¬LENGTH(TRANSNAM[PTR])
THEN BEGIN
IF FREE_DATA+2>FREE_DATA_LENGTH
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);
GOM←FALSE;
GO TO JP END;
TRANSNAM[PTR]←NN;
TRANSNUM[PTR]←FREE_DATA;
FREE_DATA←FREE_DATA+2 END;END;
JP: UNSTRUCT(T,E);
IF ¬MAC ∧ CHAN=1 THEN BEGIN
SIMIO(ONE_LINE);
OUTSTR(" X Y Z O A T"&CRLF);
WHILE TRUE DO BEGIN
FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
IF ¬GOM THEN BEGIN
OUTSTR(CRLF&CRLF);
OUTSTR(" J1 J2 J3 J4 J5 J6"&CRLF);
IF ¬MAC ∧ CHAN=1 THEN FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(ARM_VECTOR[I]));
IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CRLF&CRLF);
OUTSTR("HAND "&CVF(ARM_VECTOR[7])&CRLF);
GO TO GET1 END;
OUTSTR(CRLF&"CHANGE?"&CRLF);
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
FOR I←1 STEP 1 UNTIL 6 DO
IF LENGTH(S) THEN BEGIN
SL←SCAN(S,DEL,IFI);
R←REALSCAN(SL,IFI);
IF IFI≠-1 THEN E[I]←R;
END;
END;
ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6) END;
GO TO GET1;
END "POS";
BEGIN"SKIPN"
STRING SL;
SL←SIMIO(ONE_LINE);
I←CVO(SL);
SAY_WAIT;
ARM_SKIPN(I);
GO TO GET1
END"SKIPN";
BEGIN"SKIPS"
STRING SL;
SL←SIMIO(ONE_LINE);
I←CVO(SL);
SAY_WAIT;
ARM_SKIPS(I);
GO TO GET1
END"SKIPS";
BEGIN "DEFINE"
STRING ARRAY ARG[1:10];
INTEGER TMN;
I←GETNAME(FALSE,S,FUNNAM);
IF LENGTH(FUNNAM[I]) THEN OUTSTR(S&" MACRO NAME RESERVED WORD"&CRLF);
FOR TMN←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[TMN]) THEN DONE;
IF TMN>MAX_MACRO THEN BEGIN OUTSTR("SORRY, TOO MANY MACROS
"); GO TO GET END;
IF TMN>FMN THEN MACRO_NAME[TMN]←S;
MACRO_FORMAL[TMN]←S←SIMIO(ONE_LINE);
J←0;
WHILE LENGTH(S)
DO BEGIN SCAN(S,HEAD,BREAK);
IF BREAK=";" THEN DONE;
SL←SCAN(S,ID,BREAK);
IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
PUSH_FORMAT(0,0);
MACRO_DEFN[TMN]←NULL;
WHILE TRUE
DO BEGIN
IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*
");
S←SIMIO(ONE_LINE);
IF ¬LENGTH(S) THEN DONE;
WHILE LENGTH(S) DO BEGIN
SCAN(S,SOME,BREAK);
IF "A" ≤ BREAK ≤ "Z"
THEN BEGIN SL←SCAN(S,ID,BREAK);
FOR I←1 STEP 1 UNTIL J
DO IF EQU(SL,ARG[I])
THEN BEGIN SL←"$"&CVS(I);
DONE END;
IF BREAK=":" THEN SL←SL&":";
IF BREAK="+" ∨ BREAK="-" THEN S←BREAK&S END
ELSE
IF BREAK = ";" THEN BEGIN SL←S;S←NULL END
ELSE SL←SCAN(S,NNUMS,BREAK);
IF EQU(SL,"-") THEN S←BREAK&S;
MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&SL&(IF LENGTH(S) ∧ ¬EQU(SL,"-") THEN " " ELSE NULL);
END;
MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&'15&'12;
END;
POP_FORMAT;
OUTSTR((EDIT_NAME←MACRO_NAME[TMN])&(IF TMN≤FMN THEN " REDEFINED" ELSE " DEFINED")&CRLF);
IF TMN>FMN THEN FMN←TMN;
GO TO GET1;
END "DEFINE";
BEGIN "DUMP"
STRING SLPT,SA,SB,SC;
LABEL AL,PM;
INTEGER LINES,LTG;
STRING ARRAY ARG[1:10];
SIMIO(HEAD);
S←SIMIO(ID);
IFC BLUE THENC
IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".BLU";
ELSEC
IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".YEL";
ENDC
IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
OPEN(CHAN←CHAN+1,"DSK",0,0,3,120,BREAK,EOF);
ENTER(CHAN,S,EOF);
OUTSTR(WAIT&'15&'12);
LINES←LTG←0;
FOR I←0 STEP 1 UNTIL '77 DO
IF LENGTH(TRANSNAM[I]) THEN BEGIN
OUT(CHAN,"TRANS "&TRANSNAM[I]&" ");
ARRBLT(DIR[1],DATA_BASE[TRANSNUM[I],1],6);
FOR J←1 STEP 1 UNTIL 6 DO OUT(CHAN,CVF(DIR[J]));
OUT(CHAN,CRLF);
LINES←LINES+1;
IF LINES>50 THEN BEGIN OUT(CHAN,'14);LINES←0 END;
END;
IF LINES THEN BEGIN OUT(CHAN,CRLF&CRLF);LINES←LINES+2 END;
S←NULL;
FOR I←0 STEP 1 UNTIL '77 DO
IF LENGTH(VECTNAM[I]) THEN BEGIN
S←S&"VECT "&VECTNAM[I]&" ";
ARRBLT(DIR[1],DATA_BASE[VECTNUM[I],1],3);
FOR J←1 STEP 1 UNTIL 3 DO S←S&CVF(DIR[J]);
S←S&CRLF;
LTG←LTG+1;
IF LINES ∧ LINES+LTG>50 THEN BEGIN LINES←0; OUT(CHAN,'14) END;
IF LTG>50 THEN BEGIN OUT(CHAN,S&'14);LTG←0;S←NULL END;
END;
IF LTG THEN OUT(CHAN,S);
IF FMN THEN OUT(CHAN,'14);
LINES←LTG←0;
SLPT←NULL;
FOR I←1 STEP 1 UNTIL FMN DO BEGIN
PM: SLPT←"DEFINE "&MACRO_NAME[I]&" ";
SA←MACRO_FORMAL[I];
SB←SCAN(SA,SEMI,BREAK);
J←0;
SC←NULL;
WHILE LENGTH(SB)
DO BEGIN SCAN(SB,HEAD,BREAK);
SL←SCAN(SB,ID,BREAK);
IF LENGTH(SL) THEN SC←SC&(ARG[J←J+1]←SL)&" " END;
SLPT←SLPT&SC;
LTG←1;
IF LENGTH(SA) THEN SLPT←SLPT&SPACES[1 FOR (16-LENGTH(SC))]&SA;
SLPT←SLPT&CRLF;
S←MACRO_DEFN[I];
WHILE LENGTH(S) DO BEGIN
SA←SCAN(S,ONE_LINE,BREAK);
SB←SCAN(SA,SEMI,BREAK);
SC←NULL;
WHILE LENGTH(SB) DO BEGIN
SC←SC&SCAN(SB,DOLLAR,BREAK);
IF LENGTH(SB) THEN SC←SC&ARG[INTSCAN(SB,BREAK)];
END;
SLPT←SLPT&SC;
IF LENGTH(SA) THEN SLPT←SLPT&SPACES[1 FOR (32 - LENGTH(SC))]&SA;
SLPT←SLPT&CRLF;
AL: LTG←LTG+1;
IF LINES ∧ LINES+LTG>50 THEN BEGIN OUT(CHAN,'14);LINES←0 END;
IF LTG>50 THEN BEGIN OUT(CHAN,SLPT&'14);SLPT←NULL;LTG←0 END;
END;
IF LTG THEN BEGIN OUT(CHAN,SLPT&CRLF);
LINES←LINES+LTG+1;
LTG←0 END;
END;
RELEASE(CHAN);
CHAN←CHAN-1;
END "DUMP";
BEGIN"SET"
GETNAME(FALSE,SL,VECTNAM);
IF ¬READT(XT,S,"FRAME DOESN'T EXIST") THEN GO TO GET;
IF ¬READT(TT1,S,"WRT DOESN'T EXIST") THEN GO TO GET;
SAY_WAIT;
OPEN_ONE;
SET_ARM(SL,XT,TT1);
END"SET";
BEGIN "EDIT"
STRING SC,SO,SN,SS;
INTEGER REP;
BOOLEAN ALT;
STRING ARRAY ARG[1:10];
PROCEDURE LINED(REFERENCE STRING S;REFERENCE BOOLEAN ALT);
BEGIN STRING ST,SE;
LABEL L1,L2;
SE←S;
S←NULL;
L1: IF (REP←REP-1)≤0 THEN BEGIN
IF SC="F" THEN BEGIN ST←SE;
S←SCAN(ST,ONE_LINE,I);
WHILE LENGTH(S) DO BEGIN SCAN(S,SOME,I);
IF EQU(SS,SCAN(S,DEL,I)) THEN BEGIN S←NULL;GO TO L2 END END;
S←SE;
RETURN END;
L2: OUTSTR(SE&"?"&CRLF);
SC←INPUT(TTY,ONE_LINE);
IF ALT←BREAK=ALT_MODE THEN BEGIN S←SE;RETURN END;
ST←SCAN(SC,HEAD,BREAK);
IF SC="E" THEN BEGIN REP←999;
SC←NULL END
ELSE REP←INTSCAN(ST,BREAK);
END;
IF SC="F" THEN BEGIN ST←SC[2 TO ∞];IF LENGTH(ST) THEN SS←ST END;
IF SC="I" THEN BEGIN S←S&SE;OUTSTR("*
");
IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
SE←INCHWL END;
SE←SE&'15&'12;GO TO L1 END;
IF SC="Z" THEN BEGIN LODED(SE);
IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
SE←INCHWL END;
SE←SE&'15&'12;
IF REP=1 THEN REP←0;
IF ¬REP THEN GO TO L1 END;
IF SC="T" THEN OUTSTR(SE);
IF SC≠"D" THEN S←S&SE;
END;
IF BREAK≠'15 THEN GETNAME(FALSE,EDIT_NAME,FUNNAM);
FOR I←1 STEP 1 UNTIL FMN DO IF EQU(EDIT_NAME,MACRO_NAME[I]) THEN BEGIN
SN←"DEFINE "&MACRO_NAME[I]&" "&MACRO_FORMAL[I]&"
";
INPUT(TTY,ONE_LINE);
MAC←MAC+1;
REP←0;
SS←SC←NULL;
LINED(SN,ALT);
J←0;
S←MACRO_FORMAL[I];
WHILE LENGTH(S)
DO BEGIN SCAN(S,HEAD,BREAK);
IF BREAK=";" THEN DONE;
SL←SCAN(S,ID,BREAK);
IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
S←MACRO_DEFN[I];
SO←NULL;
WHILE LENGTH(S) DO BEGIN
SO←SO&SCAN(S,DOLLAR,BREAK);
IF LENGTH(S) THEN SO←SO&ARG[INTSCAN(S,BREAK)];
IF BREAK='12 THEN SO←SO&'15;
END;
WHILE LENGTH(SO) DO BEGIN LINED(S←SCAN(SO,ONE_LINE,BREAK)&"
",ALT);
IF ALT THEN BEGIN
OUTSTR('15&'12);
SO←S&SO;
S←SN;
SN←SL←NULL;
DO BEGIN SN←SN&SL;
SL←SCAN(S,ONE_LINE,BREAK)&'15&'12 END
UNTIL ¬LENGTH(S);
SO←SL&SO END
ELSE SN←SN&S END;
MACRO_SOURCE[MAC]←SN;
MAC_TOP[MAC]←MAC_FREE;
BBEG[MAC]←PTR3+1;
LLAB[MAC]←FREEL+1;
OUTSTR('15&'12);
GO TO GET1;
END;
END"EDIT";
BEGIN "NNUL" SAY_WAIT;OPEN_ONE;NO_NULL END"NNUL";
BEGIN "SEARCH"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
IF ¬READV(XV,S,"NORMAL DOSN'T EXIST") THEN GO TO GET;
IF ¬READV(YV,S,"FIRST DIRECTION DOSN'T EXIST") THEN GO TO GET;
SAY_WAIT;
OPEN_ONE;
SEARCH_ARM(R,XV,YV);
END"SEARCH";
BEGIN"AOJ"
STRING SC;
CODE_LINE[PTR3+1]←LINE_NO;
S←SC←SIMIO(ONE_LINE);
SCAN(SC,HEAD,J);
IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
THEN BEGIN SC←BREAK&SC;
I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
SAY_WAIT;
OPEN_ONE;
ARM_AOJ(I);
GO TO GET1;
END"AOJ";
BEGIN "TO"
REAL DIST,DEG;
IF READT(TT1,S,"TO - "&S&" TRANSFORM DOSN'T EXIST")
THEN BEGIN SIMIO(SOMETHING);
IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DIST←REALSCAN(S,BREAK);
IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
GETNAME(TRUE,S,FUNNAM);
DEG←REALSCAN(S,BREAK);
SCALE(XV,XV,DIST);
REDUCE(XV);
XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
FOR I←1 STEP 1 UNTIL 3 DO BEGIN
CVV(XV,TT1,I);
REVOLVE(XV,YV,DEG);
CVC(TT1,I,XV) END;
END;
END;
SAY_WAIT;
OPEN_ONE;
TO_ARM(TT1,ARM_PLAN);
IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
END"TO";
BEGIN"SCREW"
GETNAME(TRUE,S,FUNNAM);
R←REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
SCREW(R);
END"SCREW";
BEGIN"MOVING"
GETNAME(FALSE,SL,VECTNAM);
IF ¬READV(XV,S,"VELOCITY DOESN'T EXIST") THEN GO TO GET;
SAY_WAIT;
OPEN_ONE;
MOVING(SL,XV);
END"MOVING";
BEGIN"ASSIGN"
STRING S;
INTEGER VAL;
GETNAME(FALSE,S,VECTNAM);
GETNAME(TRUE,SL,VECTNAM);
VAL←INTSCAN(SL,BREAK);
SAY_WAIT;
OPEN_ONE;
ARM_ASSIGN(S,VAL);
END"ASSIGN";
BEGIN"SOJG"
INTEGER I;
STRING SL,SC;
CODE_LINE[PTR3+1]←LINE_NO;
GETNAME(FALSE,SL,VECTNAM);
S←SC←SIMIO(ONE_LINE);
SCAN(SC,HEAD,J);
IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
THEN BEGIN SC←BREAK&SC;
I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
SAY_WAIT;
OPEN_ONE;
ARM_SOJG(SL,I);
GO TO GET1;
END"SOJG";
IFC THROWING THENC
BEGIN "THROW"
INTEGER SUCCESS;
REAL FORE, AFT;
IF READT(TT1,S,"THROW - "&S&" RELEASE DOSN'T EXIST")
∧ READV(XV,S,"THROW - "&S&" VELOCITY DOSN'T EXIST")
∧ READT(XT,S,"THROW - "&S&" FINAL DOSN'T EXIST")
THEN BEGIN
GETNAME(TRUE,S,FUNNAM);
FORE ← REALSCAN(S,BREAK);
GETNAME(TRUE,S,FUNNAM);
AFT ← REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
THROW(TT1,XV,XT,FORE,AFT,SUCCESS);
IF ¬SUCCESS THEN OUTSTR(" SORRY UNABLE TO THROW"&CRLF);
END
END "THROW";
BEGIN "TOSS"
INTEGER SUCCESS;
REAL FORE, AFT, V;
SAFE REAL OWN ARRAY VEL[1:4];
IF READT(TT1,S,"TOSS - "&S&" RELEASE DOESN'T EXIST")
∧ READV(XV,S,"TOSS - "&S&" TARGET DOESN'T EXIST")
∧ READT(XT,S,"TOSS - "&S&" FINAL DOESN'T EXIST")
THEN BEGIN
GETNAME(TRUE,S,FUNNAM);
V ← REALSCAN(S,BREAK);
SAY_WAIT;
OPEN_ONE;
BALLIST(VEL,TT1,XV,V,SUCCESS);
IF ¬SUCCESS THEN OUTSTR("NO BALLISTIC SOLUTION"&CRLF)
ELSE THROW(TT1,VEL,XT,0.05,-0.05,SUCCESS);
IF ¬SUCCESS THEN OUTSTR(" SORRY, CAN'T THROW"&CRLF);
END;
END "TOSS";
ENDC
IFC GRAPHICS THENC
BEGIN "DISPLAY"
SAFE INTEGER ARRAY DISPLY[1:'3000];
STRING SLL,LLL;
LABEL TOP;
INTEGER POG;
SAFE INTEGER ARRAY FDATA[0:'2200];
STRING SIMPLE PROCEDURE SCAN_DATA(INTEGER TL,TU;STRING IND;SIMPLE PROCEDURE UP);
BEGIN INTEGER ERROR,TICK,REQD,THIS,N;
INTEGER MISSED;
BOOLEAN FIRST;
LABEL NEXT;
LOOKUP('17,DFILE&".TMP",EOF);
IF EOF THEN RETURN("FILE NOT FOUND");
REQD←CVSIX(IND);
TICK←CVSIX("TICK");
ERROR←CVSIX("ERROR");
TIME←-1;
FIRST←TRUE;
MISSED←0;
PTR←0;
BP←0;
HIT←0;
ARRYIN('17,FDATA[0],'200);
DO BEGIN "READ_LOOP"
ARRYIN('17,FDATA['200],'2000);
DO BEGIN "ITEM_LOOP"
THIS←FDATA[PTR] LAND '777777777700;
IF ¬THIS THEN RETURN(NULL);
IF THIS=TICK THEN BEGIN
MISSED←0;
TIME←TIME+1;
IF TIME<TL THEN GO TO NEXT;
IF TIME>TU THEN RETURN(NULL);
HIT←HIT+1;
IF MODULUS<2 ∨ ¬(HIT MOD MODULUS) THEN BEGIN
BUFFER[BP+1]←BUFFER[BP];
BP←BP+1;
END;
END;
IF THIS=REQD THEN BEGIN
UP;
IF FIRST THEN BEGIN
BUFFER[1]←BUFFER[BP];
ARRBLT(BUFFER[2],BUFFER[1],BP-2);
FIRST←FALSE;
END;
END;
NEXT: IF(N←FDATA[PTR] LAND '77)>'37 ∨ THIS=ERROR THEN
BEGIN MISSED←-1;
OUTSTR(CVS(TIME)&" DATA MISSED");
END;
PTR←PTR+1+(IF MISSED THEN 0 ELSE N);
END UNTIL PTR>'1777;
PTR←PTR-'2000;
ARRBLT(FDATA[0],FDATA['2000],'200);
END UNTIL EOF;
RETURN("END OF FILE");
END"SCAN_DATA";
SIMPLE PROCEDURE WHEN;
BEGIN
INTEGER I;
PRELOAD_WITH "OPEN_HAND","CLOSE_HAND","WAIT_ARM","PLACE_ARM","CHANGE_ARM","SET_TOUCH","STOP_ARM",
"SAVE_ARM","RESTORE_ARM","CENTER_ARM","SET_ARM","WOBBLE_ARM","SEARCH_ARM",
"AOJ_ARM","GO_ARM","GOTO_ARM","MOVE_ARM","SCREW_ARM",
"DRIVE_ARM","MOVING","ASSIGN","SOJG";
OWN STRING ARRAY FUNCTION[1:22];
IF (I←FDATA[PTR+1] LAND '77) THEN SM←SM&CVS(TIME)&" "&FUNCTION[I]&CRLF;
END;
SIMPLE PROCEDURE REAL6;
BEGIN
INTEGER I;
REAL R;
I←FDATA[PTR+INDEX];
START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
BUFFER[BP]←R;
END;
SIMPLE PROCEDURE REAL1;
BEGIN
INTEGER I;
REAL R;
I←FDATA[PTR+1];
START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
BUFFER[BP]←R;
END;
SIMPLE PROCEDURE INT1;BUFFER[BP]←FDATA[PTR+1];
SIMPLE PROCEDURE INT6;
BUFFER[BP]←FDATA[PTR+INDEX];
PROCEDURE BIGHT;
BEGIN LABEL FOUND;
INTEGER BITE,T,I,J,K;
SAFE INTEGER ARRAY FEEL[1:2,1:2,1:4];
START_CODE
HRRZI 1,FDATA;
HRR 1,(1);
ADD 1,PTR;
HRLI 1,'1400;
MOVEM 1,BITE;
END;
FOR I←2 STEP -1 UNTIL 1 DO BEGIN"FINGER"
FOR J←2 STEP -1 UNTIL 1 DO
FOR K←4 STEP -1 UNTIL 1 DO
IF INDEX=I ∧ TIP=J ∧ PAD=K THEN
BEGIN"THE ONE"
T←ILDB(BITE);
START_CODE
LABEL POS,BACK;
MOVE 1,T;
TRNE 1,'2000;
JRST POS;
TRZ 1,'774000;
JRST BACK;
POS: TDO 1,NMASK;
BACK: MOVNM 1,T;
END;
GO TO FOUND;
END "THE ONE" ELSE IBP(BITE);
IBP(BITE);
END "FINGER";
FOUND: BUFFER[BP]←T;
END;
STRING SL;
SL←SIMIO(ONE_LINE);
SCAN(SL,HEAD,BREAK);
IF ¬LENGTH(DFILE←SCAN(SL,ID,BREAK)) THEN DFILE←LFILE;
OPEN('17,"DSK",'17,0,0,120,BREAK,EOF);
MODULUS←1000;
SM←"
TIME FUNCTION"&CRLF;
SETFORMAT(4,0);
S11←SCAN_DATA(0,5000,"NEXT",WHEN);
SM←SM&CVS(TIME)&" "&S11&CRLF;
OUTSTR(SM);
OUTSTR("DISPLAY, FUNCTION, FROM, TO ?"&CRLF);
SETFORMAT(0,0);
WHILE TRUE DO BEGIN
LODED(OL);
SLL←LLL←INCHWL;
SCAN(LLL,HEAD,BREAK);S11←SCAN(LLL,ID,BREAK);
IF EQU(S11,"X") THEN DONE;
IF EQU(S11,"N") THEN BEGIN RELEASE('17);GO TO GET1 END;
IF EQU(S11,"C") THEN BEGIN DPYCLR;RELEASE('17);GO TO GET1 END;
IF EQU(S11,"P") THEN BEGIN
STRING FILNAM;
INTEGER FLG,CHN;
CHN ← 14;
OPEN(CHN,"DSK",8,0,3,0,0,0);
DO BEGIN
OUTSTR(13&10&"PLOT FILE = ");
FILNAM ← INCHWL;
ENTER(CHN,FILNAM&".PLT",FLG);
END UNTIL ¬FLG;
ARRYOUT(CHN,DISPLY[1],DISPLY[2]);
RELEASE(CHN);
GO TO TOP;
END;
SCAN(LLL,HEAD,BREAK);FUNCTION←SCAN(LLL,ID,BREAK);
IF EQU(S11,"D")THEN BEGIN
OL←SLL;
LL←INTSCAN(LLL,BREAK);
UL←INTSCAN(LLL,BREAK);
MODULUS←1+(UL-LL)%100;
DPYCLR;
POG←GETPOG;
DPYSET(DISPLY);
AIVECT(-511,450);
END;
IF EQU(FUNCTION,"POS")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTSCAN(LLL,BREAK);
FACTOR←100.0;
SCAN_DATA(LL,UL,"THETA",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"POSITION ERROR 1/100 DEG"&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"VEL")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTSCAN(LLL,BREAK);
FACTOR←100.0;
SCAN_DATA(LL,UL,"VEL",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"VELOCITY ERROR 1/100 DEG"&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"MOTOR")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTSCAN(LLL,BREAK);
SCAN_DATA(LL,UL,"DAC",INT6);
IFC ¬BLUE THENC
FOR I←1 STEP 1 UNTIL BP DO BUFFER[I]←BUFFER[I]*300/'776000;
ENDC
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"MOTOR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"DRIVE")THEN BEGIN
OUTSTR("INDEX ?"&CRLF);
INDEX←INTSCAN(LLL,BREAK);
FACTOR←10.0;
SCAN_DATA(LL,UL,"BACK",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
BP←HIT←0;
SCAN_DATA(LL,UL,"FORD",REAL6);
ARRGRF(BUFFER,1,BP,-300,-300,0,700,"T/"&CVS(MODULUS),
"DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"HAND")THEN BEGIN
FACTOR←100.0;
SCAN_DATA(LL,UL,"HAND",REAL1);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"HAND FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"TIME")THEN BEGIN
SCAN_DATA(LL,UL,"TICK",INT1);
ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
"TIME FROM "&CVS(LL)&" TO "&CVS(UL));
DPYOUT(POG);
GO TO TOP;
END;
IF EQU(FUNCTION,"TOUCH")THEN BEGIN
OUTSTR("FINGER, TIP ?"&CRLF);
INDEX←INTIN(1);
TIP←INTIN(1);
FOR PAD←1 STEP 1 UNTIL 4 DO BEGIN
SCAN_DATA(LL,UL,"TOUCH",BIGHT);
ARRGRF(BUFFER,1,BP,-300,-300+(PAD-1)*180,800,150,"T/"&CVS(MODULUS),
"TOUCH FROM "&CVS(LL)&" TO "&CVS(UL));
END;
DPYOUT(POG);
GO TO TOP;
END;
OUTSTR("UNRECOGINZED COMMAND"&CRLF);
TOP:END;
GO TO GET1;
END"DISPLAY";
ENDC
END ELSE
BEGIN
FOR I←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[I])
THEN BEGIN
S←SIMIO(ONE_LINE);
SL←NULL;FOR J←1 STEP 1 UNTIL MAC DO SL←SL&" ";
IF MAC THEN OUTSTR(SL&MACRO_NAME[I]&CRLF) ELSE OUTSTR("O.K."&CRLF);
MAC←MAC+1;
MACRO_SOURCE[MAC]←MACRO_DEFN[I];
MAC_TOP[MAC]←MAC_FREE;
WHILE LENGTH(S) DO BEGIN
SCAN(S,SOME,BREAK);
IF BREAK="$"
THEN BEGIN I←INTSCAN(S,BREAK);
I←I+MAC_TOP[MAC-1];
IF I<1 ∨ I> MAC_TOP[MAC]
THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
GO TO GET END;
SL←MAC_PAR[I] END
ELSE SL←IF "A"≤ BREAK ≤"Z" THEN SCAN(S,ID,I) ELSE SCAN(S,NNUMS,I);
IF LENGTH(SL) THEN MAC_PAR[MAC_FREE←MAC_FREE+1]←SL END;
BBEG[MAC]←PTR3+1;
LLAB[MAC]←FREEL+1;
GO TO GET1;
END;
OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNRECOGINIZED COMMAND"&CRLF);
END;
GO TO GET;